home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus 2000 #5 / Amiga Plus CD - 2000 - No. 5.iso / Tools / Dev / fpc / units / strings.pp < prev    next >
Text File  |  1998-10-28  |  20KB  |  664 lines
  1. {
  2.     $Id: strings.pp,v 1.2 1998/07/01 14:29:42 carl Exp $
  3.     This file is part of the Free Pascal run time library.
  4.     Copyright (c) 1997 by Carl-Eric Codere,
  5.     member of the Free Pascal development team.
  6.  
  7.     See the file COPYING.FPC, included in this distribution,
  8.     for details about the copyright.
  9.  
  10.     This program is distributed in the hope that it will be useful,
  11.     but WITHOUT ANY WARRANTY; without even the implied warranty of
  12.     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  13.  
  14.  **********************************************************************}
  15.  
  16. {
  17.     History:
  18.  
  19.     Added StrAlloc.
  20.     12 Oct 1998
  21.     nils.sjoholm@mailbox.swipnet.se
  22. }
  23.  
  24. Unit Strings;
  25.  
  26.  
  27.   {*********************************************************************}
  28.   { Strings unit, 100% portable.                                        }
  29.   {- COMPILING INFORMATION ---------------------------------------------}
  30.   {   The only difference between this  unit and the one supplied with  }
  31.   {   Turbo Pascal 7.01, are that StrLen returns a longint, and the     }
  32.   {   routines requiring a length now use longints instead of words.    }
  33.   {   This should not influence the behaviour of your programs under    }
  34.   {   Turbo Pascal. (it will even create better error checking for your }
  35.   {   programs).                                                        }
  36.   {*********************************************************************}
  37.  
  38.  Interface
  39.  {*********************************************************************}
  40.  { Returns the number of Characters in Str,not counting the Null       }
  41.  { chracter.                                                           }
  42.  {*********************************************************************}
  43.  
  44. function StrLen(Str: PChar): longint;
  45.  
  46.  
  47. function StrEnd(Str: PChar): PChar;
  48.  
  49.   {*********************************************************************}
  50.   {  Description: Move count characters from source to dest.            }
  51.   {   Do not forget to use StrLen(source)+1 as l parameter to also move }
  52.   {   the null character.                                               }
  53.   {  Return value: Dest                                                 }
  54.   {   Remarks: Source and Dest may overlap.                             }
  55.   {*********************************************************************}
  56.  
  57. function StrMove(Dest,Source : Pchar;l : Longint) : pchar;
  58.  
  59.  
  60. function StrCopy(Dest, Source: PChar): PChar;
  61.  
  62.  {*********************************************************************}
  63.  {  Input: Source -> Source of the null-terminated string to copy.     }
  64.  {         Dest   -> Destination of null terminated string to copy.    }
  65.  {    Return Value: Pointer to the end of the copied string of Dest.   }
  66.  {  Output: Dest ->   Pointer to the copied string.                    }
  67.  {*********************************************************************}
  68. function StrECopy(Dest, Source: PChar): PChar;
  69.  
  70.   {*********************************************************************}
  71.   {  Copies at most MaxLen characters from Source to Dest.              }
  72.   {                                                                     }
  73.   {   Remarks: According to the Turbo Pascal programmer's Reference     }
  74.   {    this routine performs length checking. From the code of the      }
  75.   {    original strings unit, this does not seem true...                }
  76.   {   Furthermore, copying a null string gives two null characters in   }
  77.   {   the destination according to the Turbo Pascal routine.            }
  78.   {*********************************************************************}
  79.  
  80. function StrLCopy(Dest, Source: PChar; MaxLen: Longint): PChar;
  81.  
  82.  {*********************************************************************}
  83.  {  Input: Source -> Source of the pascal style string to copy.        }
  84.  {         Dest   -> Destination of null terminated string to copy.    }
  85.  {    Return Value: Dest. (with noew copied string)                    }
  86.  {*********************************************************************}
  87.  
  88. function StrPCopy(Dest: PChar; Source: String): PChar;
  89.  
  90.  {*********************************************************************}
  91.  {  Description: Appends a copy of Source to then end of Dest and      }
  92.  {               return Dest.                                          }
  93.  {*********************************************************************}
  94.  
  95. function StrCat(Dest, Source: PChar): PChar;
  96.  
  97.  {*********************************************************************}
  98.  { Description: Appends at most MaxLen - StrLen(Dest) characters from  }
  99.  { Source to the end of Dest, and returns Dest.                        }
  100.  {*********************************************************************}
  101.  
  102.       function strlcat(dest,source : pchar;l : Longint) : pchar;
  103.  
  104.   {*********************************************************************}
  105.   {  Compares two strings. Does the ASCII value substraction of the     }
  106.   {  first non matching characters                                      }
  107.   {   Returns 0 if both strings are equal                               }
  108.   {   Returns < 0 if Str1 < Str2                                        }
  109.   {   Returns > 0 if Str1 > Str2                                        }
  110.   {*********************************************************************}
  111.  
  112. function StrComp(Str1, Str2: PChar): Integer;
  113.  
  114.   {*********************************************************************}
  115.   {  Compares two strings without case sensitivity. See StrComp for more}
  116.   {  information.                                                       }
  117.   {   Returns 0 if both strings are equal                               }
  118.   {   Returns < 0 if Str1 < Str2                                        }
  119.   {   Returns > 0 if Str1 > Str2                                        }
  120.   {*********************************************************************}
  121.  
  122. function StrIComp(Str1, Str2: PChar): Integer;
  123.  
  124.   {*********************************************************************}
  125.   {  Compares two strings up to a maximum of MaxLen characters.         }
  126.   {                                                                     }
  127.   {   Returns 0 if both strings are equal                               }
  128.   {   Returns < 0 if Str1 < Str2                                        }
  129.   {   Returns > 0 if Str1 > Str2                                        }
  130.   {*********************************************************************}
  131.  
  132. function StrLComp(Str1, Str2: PChar; MaxLen: Longint): Integer;
  133.  
  134.   {*********************************************************************}
  135.   {  Compares two strings up to a maximum of MaxLen characters.         }
  136.   {  The comparison is case insensitive.                                }
  137.   {   Returns 0 if both strings are equal                               }
  138.   {   Returns < 0 if Str1 < Str2                                        }
  139.   {   Returns > 0 if Str1 > Str2                                        }
  140.   {*********************************************************************}
  141.  
  142. function StrLIComp(Str1, Str2: PChar; MaxLen: Longint): Integer;
  143.  
  144.  {*********************************************************************}
  145.  {  Input: Str  -> String to search.                                   }
  146.  {         Ch   -> Character to find in Str.                           }
  147.  {  Return Value: Pointer to first occurence of Ch in Str, nil if      }
  148.  {                not found.                                           }
  149.  {  Remark: The null terminator is considered being part of the string }
  150.  {*********************************************************************}
  151.  
  152. function StrScan(Str: PChar; Ch: Char): PChar;
  153.  
  154.  {*********************************************************************}
  155.  {  Input: Str  -> String to search.                                   }
  156.  {         Ch   -> Character to find in Str.                           }
  157.  {  Return Value: Pointer to last occurence of Ch in Str, nil if       }
  158.  {                not found.                                           }
  159.  {  Remark: The null terminator is considered being part of the string }
  160.  {*********************************************************************}
  161.  
  162.  
  163. function StrRScan(Str: PChar; Ch: Char): PChar;
  164.  
  165.  {*********************************************************************}
  166.  {  Input: Str1 -> String to search.                                   }
  167.  {         Str2 -> String to match in Str1.                            }
  168.  {  Return Value: Pointer to first occurence of Str2 in Str1, nil if   }
  169.  {                not found.                                           }
  170.  {*********************************************************************}
  171.  
  172. function StrPos(Str1, Str2: PChar): PChar;
  173.  
  174.  {*********************************************************************}
  175.  {  Input: Str -> null terminated string to uppercase.                 }
  176.  {  Output:Str -> null terminated string in upper case characters.     }
  177.  {    Return Value: null terminated string in upper case characters.   }
  178.  {  Remarks: Case conversion is dependant on upcase routine.           }
  179.  {*********************************************************************}
  180.  
  181. function StrUpper(Str: PChar): PChar;
  182.  
  183.  {*********************************************************************}
  184.  {  Input: Str -> null terminated string to lower case.                }
  185.  {  Output:Str -> null terminated string in lower case characters.     }
  186.  {    Return Value: null terminated string in lower case characters.   }
  187.  {  Remarks: Only converts standard ASCII characters.                  }
  188.  {*********************************************************************}
  189.  
  190. function StrLower(Str: PChar): PChar;
  191.  
  192. { StrPas converts Str to a Pascal style string.                 }
  193.  
  194. function StrPas(Str: PChar): String;
  195.  
  196.  {*********************************************************************}
  197.  {  Input: Str  -> String to duplicate.                                }
  198.  {  Return Value: Pointer to the new allocated string. nil if no       }
  199.  {                  string allocated. If Str = nil then return value   }
  200.  {                  will also be nil (in this case, no allocation      }
  201.  {                  occurs). The size allocated is of StrLen(Str)+1    }
  202.  {                  bytes.                                             }
  203.  {*********************************************************************}
  204. function StrNew(P: PChar): PChar;
  205.  
  206. { StrDispose disposes a string that was previously allocated    }
  207. { with StrNew. If Str is NIL, StrDispose does nothing.          }
  208.  
  209. procedure StrDispose(P: PChar);
  210.  
  211. function StrAlloc(l : longint): PChar;
  212.  
  213. Implementation
  214.  
  215.  
  216.  function strlen(Str : pchar) : Longint;
  217.   var
  218.    counter : Longint;
  219.  Begin
  220.    counter := 0;
  221.    while Str[counter] <> #0 do
  222.      Inc(counter);
  223.    strlen := counter;
  224.  end;
  225.  
  226.  
  227.  
  228.  Function strpas(Str: pchar): string;
  229.  { only 255 first characters are actually copied. }
  230.   var
  231.    counter : byte;
  232.    lstr: string;
  233.  Begin
  234.    counter := 0;
  235.    lstr := '';
  236.    while (ord(Str[counter]) <> 0) and (counter < 255) do
  237.    begin
  238.      Inc(counter);
  239.      lstr[counter] := char(Str[counter-1]);
  240.    end;
  241.    lstr[0] := char(counter);
  242.    strpas := lstr;
  243.  end;
  244.  
  245.  Function StrEnd(Str: PChar): PChar;
  246.  var
  247.   counter: Longint;
  248.  begin
  249.    counter := 0;
  250.    while Str[counter] <> #0 do
  251.       Inc(counter);
  252.    StrEnd := @(Str[Counter]);
  253.  end;
  254.  
  255.  
  256.  Function StrCopy(Dest, Source:PChar): PChar;
  257.  var
  258.    counter : Longint;
  259.  Begin
  260.    counter := 0;
  261.    while Source[counter] <> #0 do
  262.    begin
  263.      Dest[counter] := char(Source[counter]);
  264.      Inc(counter);
  265.    end;
  266.    { terminate the string }
  267.    Dest[counter] := #0;
  268.    StrCopy := Dest;
  269.  end;
  270.  
  271.  
  272.  function StrCat(Dest,Source: PChar): PChar;
  273.  var
  274.   counter: Longint;
  275.   PEnd: PChar;
  276.  begin
  277.    PEnd := StrEnd(Dest);
  278.    counter := 0;
  279.    while (Source[counter] <> #0) do
  280.    begin
  281.      PEnd[counter] := char(Source[counter]);
  282.      Inc(counter);
  283.    end;
  284.    { terminate the string }
  285.    PEnd[counter] := #0;
  286.    StrCat := Dest;
  287.  end;
  288.  
  289.  function StrUpper(Str: PChar): PChar;
  290.  var
  291.   counter: Longint;
  292.  begin
  293.    counter := 0;
  294.    while (Str[counter] <> #0) do
  295.    begin
  296.      if Str[Counter] in [#97..#122,#128..#255] then
  297.         Str[counter] := Upcase(Str[counter]);
  298.      Inc(counter);
  299.    end;
  300.    StrUpper := Str;
  301.  end;
  302.  
  303.  function StrLower(Str: PChar): PChar;
  304.  var
  305.   counter: Longint;
  306.  begin
  307.    counter := 0;
  308.    while (Str[counter] <> #0) do
  309.    begin
  310.      if Str[counter] in [#65..#90] then
  311.         Str[Counter] := chr(ord(Str[Counter]) + 32);
  312.      Inc(counter);
  313.    end;
  314.    StrLower := Str;
  315.  end;
  316.  
  317.  
  318.   function StrPos(Str1,Str2: PChar): PChar;
  319.  var
  320.   count: Longint;
  321.   oldindex: Longint;
  322.   found: boolean;
  323.   Str1Length: Longint;
  324.   Str2Length: Longint;
  325.   ll: Longint;
  326.  Begin
  327.  
  328.    Str1Length := StrLen(Str1);
  329.    Str2Length := StrLen(Str2);
  330.    found := true;
  331.    oldindex := 0;
  332.  
  333.    { If the search string is greater than the string to be searched }
  334.    { it is certain that we will not find it.                        }
  335.    { Furthermore looking for a null will simply give out a pointer, }
  336.    { to the null character of str1 as in Borland Pascal.            }
  337.    if (Str2Length > Str1Length) or (Str2[0] = #0) then
  338.    begin
  339.      StrPos := nil;
  340.      exit;
  341.    end;
  342.  
  343.    Repeat
  344.      { Find first matching character of Str2 in Str1 }
  345.      { put index of this character in oldindex       }
  346.      for count:= oldindex to Str1Length-1 do
  347.      begin
  348.         if Str2[0] = Str1[count] then
  349.         begin
  350.            oldindex := count;
  351.            break;
  352.         end;
  353.         { nothing found - exit routine }
  354.         if count = Str1Length-1 then
  355.         begin
  356.            StrPos := nil;
  357.            exit;
  358.         end;
  359.      end;
  360.  
  361.      found := true;
  362.      { Compare the character strings }
  363.      { and check if they match.      }
  364.      for ll := 0 to Str2Length-1 do
  365.      begin
  366.        { no match, stop iteration }
  367.         if (Str2[ll] <> Str1[ll+oldindex]) then
  368.         begin
  369.            found := false;
  370.            break;
  371.         end;
  372.      end;
  373.      { Not found, the index will no point at next character }
  374.      if not found then
  375.        Inc(oldindex);
  376.      { There was a match }
  377.      if found then
  378.      begin
  379.         StrPos := @(Str1[oldindex]);
  380.         exit;
  381.      end;
  382.    { If we have gone through the whole string to search }
  383.    { then exit routine.                                 }
  384.    Until (Str1Length-oldindex) <= 0;
  385.    StrPos := nil;
  386.  end;
  387.  
  388.  
  389.  function StrScan(Str: PChar; Ch: Char): PChar;
  390.    Var
  391.      count: Longint;
  392.   Begin
  393.  
  394.    count := 0;
  395.    { As in Borland Pascal , if looking for NULL return null }
  396.    if ch = #0 then
  397.    begin
  398.      StrScan := @(Str[StrLen(Str)]);
  399.      exit;
  400.    end;
  401.    { Find first matching character of Ch in Str }
  402.    while Str[count] <> #0 do
  403.    begin
  404.      if Ch = Str[count] then
  405.       begin
  406.           StrScan := @(Str[count]);
  407.           exit;
  408.       end;
  409.      Inc(count);
  410.    end;
  411.    { nothing found. }
  412.    StrScan := nil;
  413.  end;
  414.  
  415.  
  416.  
  417.  function StrRScan(Str: PChar; Ch: Char): PChar;
  418.  Var
  419.   count: Longint;
  420.   index: Longint;
  421.  Begin
  422.    count := Strlen(Str);
  423.    { As in Borland Pascal , if looking for NULL return null }
  424.    if ch = #0 then
  425.    begin
  426.      StrRScan := @(Str[count]);
  427.      exit;
  428.    end;
  429.    Dec(count);
  430.    for index := count downto 0 do
  431.    begin
  432.      if Ch = Str[index] then
  433.       begin
  434.           StrRScan := @(Str[index]);
  435.           exit;
  436.       end;
  437.    end;
  438.    { nothing found. }
  439.    StrRScan := nil;
  440.  end;
  441.  
  442.  
  443.  function StrNew(p:PChar): PChar;
  444.       var
  445.          len : Longint;
  446.          tmp : pchar;
  447.       begin
  448.          strnew:=nil;
  449.          if (p=nil) or (p^=#0) then
  450.            exit;
  451.          len:=strlen(p)+1;
  452.          getmem(tmp,len);
  453.          if tmp<>nil then
  454.            strmove(tmp,p,len);
  455.          StrNew := tmp;
  456.       end;
  457.  
  458.  
  459.   Function StrECopy(Dest, Source: PChar): PChar;
  460.  { Equivalent to the following:                                          }
  461.  {  strcopy(Dest,Source);                                                }
  462.  {  StrECopy := StrEnd(Dest);                                            }
  463.  var
  464.    counter : Longint;
  465.  Begin
  466.    counter := 0;
  467.    while Source[counter] <> #0 do
  468.    begin
  469.      Dest[counter] := char(Source[counter]);
  470.      Inc(counter);
  471.    end;
  472.    { terminate the string }
  473.    Dest[counter] := #0;
  474.    StrECopy:=@(Dest[counter]);
  475.  end;
  476.  
  477.  
  478.    Function StrPCopy(Dest: PChar; Source: String):PChar;
  479.    var
  480.     counter : byte;
  481.   Begin
  482.     counter := 0;
  483.    { if empty pascal string  }
  484.    { then setup and exit now }
  485.    if Source = '' then
  486.    Begin
  487.      Dest[0] := #0;
  488.      StrPCopy := Dest;
  489.      exit;
  490.    end;
  491.    for counter:=1 to length(Source) do
  492.    begin
  493.      Dest[counter-1] := Source[counter];
  494.    end;
  495.    { terminate the string }
  496.    Dest[counter] := #0;
  497.    StrPCopy:=Dest;
  498.  end;
  499.  
  500.  
  501.  procedure strdispose(p : pchar);
  502.  begin
  503.    if p<>nil then
  504.       freemem(p,strlen(p)+1);
  505.  end;
  506.  
  507.  function stralloc(l : longint): pchar;
  508.  var
  509.    p : pchar;
  510.  begin
  511.    getmem(p,l);
  512.    stralloc := p;
  513.  end;
  514.  
  515.  
  516.  
  517.  function strmove(dest,source : pchar;l : Longint) : pchar;
  518.  begin
  519.    move(source^,dest^,l);
  520.    strmove:=dest;
  521.  end;
  522.  
  523.  
  524.  function strlcat(dest,source : pchar;l : Longint) : pchar;
  525.  var
  526.    destend : pchar;
  527.  begin
  528.    destend:=strend(dest);
  529.    l:=l-(destend-dest);
  530.    strlcat:=strlcopy(destend,source,l);
  531.  end;
  532.  
  533.  
  534.  Function StrLCopy(Dest,Source: PChar; MaxLen: Longint): PChar;
  535.   var
  536.    counter: Longint;
  537.  Begin
  538.    counter := 0;
  539.    { To be compatible with BP, on a null string, put two nulls }
  540.    If Source[0] = #0 then
  541.    Begin
  542.      Dest[0]:=Source[0];
  543.      Inc(counter);
  544.    end;
  545.    while (Source[counter] <> #0)  and (counter < MaxLen) do
  546.    Begin
  547.       Dest[counter] := char(Source[counter]);
  548.       Inc(counter);
  549.    end;
  550.    { terminate the string }
  551.    Dest[counter] := #0;
  552.    StrLCopy := Dest;
  553.  end;
  554.  
  555.  
  556.  function StrComp(Str1, Str2 : PChar): Integer;
  557.      var
  558.       counter: Longint;
  559.      Begin
  560.         counter := 0;
  561.        While str1[counter] = str2[counter] do
  562.        Begin
  563.          if (str2[counter] = #0) or (str1[counter] = #0) then
  564.             break;
  565.          Inc(counter);
  566.        end;
  567.        StrComp := ord(str1[counter]) - ord(str2[counter]);
  568.      end;
  569.  
  570.      function StrIComp(Str1, Str2 : PChar): Integer;
  571.      var
  572.       counter: Longint;
  573.       c1, c2: char;
  574.      Begin
  575.         counter := 0;
  576.         c1 := upcase(str1[counter]);
  577.         c2 := upcase(str2[counter]);
  578.        While c1 = c2 do
  579.        Begin
  580.          if (c1 = #0) or (c2 = #0) then break;
  581.          Inc(counter);
  582.          c1 := upcase(str1[counter]);
  583.          c2 := upcase(str2[counter]);
  584.       end;
  585.        StrIComp := ord(c1) - ord(c2);
  586.      end;
  587.  
  588.  
  589.      function StrLComp(Str1, Str2 : PChar; MaxLen: Longint): Integer;
  590.      var
  591.       counter: Longint;
  592.       c1, c2: char;
  593.      Begin
  594.         counter := 0;
  595.        if MaxLen = 0 then
  596.        begin
  597.          StrLComp := 0;
  598.          exit;
  599.        end;
  600.        Repeat
  601.          if (c1 = #0) or (c2 = #0) then break;
  602.          c1 := str1[counter];
  603.          c2 := str2[counter];
  604.          Inc(counter);
  605.       Until (c1 <> c2) or (counter >= MaxLen);
  606.        StrLComp := ord(c1) - ord(c2);
  607.      end;
  608.  
  609.  
  610.  
  611.      function StrLIComp(Str1, Str2 : PChar; MaxLen: Longint): Integer;
  612.      var
  613.       counter: Longint;
  614.       c1, c2: char;
  615.      Begin
  616.         counter := 0;
  617.        if MaxLen = 0 then
  618.        begin
  619.          StrLIComp := 0;
  620.          exit;
  621.        end;
  622.        Repeat
  623.          if (c1 = #0) or (c2 = #0) then break;
  624.          c1 := upcase(str1[counter]);
  625.          c2 := upcase(str2[counter]);
  626.          Inc(counter);
  627.       Until (c1 <> c2) or (counter >= MaxLen);
  628.        StrLIComp := ord(c1) - ord(c2);
  629.      end;
  630. end.
  631. {
  632.   $Log: strings.pp,v $
  633.   Revision 1.2  1998/07/01 14:29:42  carl
  634.     * strpas bugfix
  635.  
  636.   Revision 1.1.1.1  1998/03/25 11:18:46  root
  637.   * Restored version
  638.  
  639.   Revision 1.4  1998/01/26 12:02:01  michael
  640.   + Added log at the end
  641.  
  642.  
  643.   
  644.   Working file: rtl/template/strings.pp
  645.   description:
  646.   ----------------------------
  647.   revision 1.3
  648.   date: 1998/01/05 00:41:57;  author: carl;  state: Exp;  lines: +4 -4
  649.   * Esthetic (spelling mistake) fix
  650.   ----------------------------
  651.   revision 1.2
  652.   date: 1997/12/01 12:45:49;  author: michael;  state: Exp;  lines: +14 -1
  653.   + added copyright reference in header.
  654.   ----------------------------
  655.   revision 1.1
  656.   date: 1997/11/27 08:33:49;  author: michael;  state: Exp;
  657.   Initial revision
  658.   ----------------------------
  659.   revision 1.1.1.1
  660.   date: 1997/11/27 08:33:49;  author: michael;  state: Exp;  lines: +0 -0
  661.   FPC RTL CVS start
  662.   =============================================================================
  663. }
  664.